home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / HAMRADIO / KAM401.ZIP / KAM-AUX.PAS < prev    next >
Pascal/Delphi Source File  |  1989-08-25  |  8KB  |  377 lines
  1. procedure show_time;
  2. begin
  3.   status_color;
  4.   gotoxy(66,status_line);
  5.   write(' ',date,' ',time);
  6.   gotoxy(xin,yin);
  7. end;
  8.  
  9. procedure disp_time;
  10. begin
  11.   if time <> old_time then
  12.   begin
  13.     old_time := time;
  14.     show_time;
  15.   end;
  16. end;
  17.  
  18. procedure disp_xmt_wpm;
  19. begin
  20.   gotoxy(6,status_line);
  21.   status_color;
  22.   write(xmt_wpm:2);
  23.   gotoxy(xin,yin);
  24. end;
  25.  
  26. procedure disp_rcv_wpm;
  27. begin
  28.   gotoxy(16,status_line);
  29.   status_color;
  30.   write(rcv_wpm:2);
  31.   gotoxy(xin,yin);
  32. end;
  33.  
  34. procedure cw_status_line;
  35. begin
  36.   write('CW      xmt,      rcv ');
  37.   disp_xmt_wpm;
  38.   disp_rcv_wpm;
  39. end;
  40.  
  41. procedure rtty_ascii_line;
  42. begin
  43.   write(baud_rate[baud]:3,' baud, ',rtty_shift[shift]:5,' shift ');
  44.   gotoxy(55,status_line);
  45.   case invert of
  46.     TRUE          : write(' INVERT ');
  47.     FALSE         : write(' NORMAL ');
  48.   end;
  49.   gotoxy(xin,yin);
  50. end;
  51.  
  52. procedure rtty_status_line;
  53. begin
  54.   write('RTTY ');
  55.   rtty_ascii_line;
  56. end;
  57.  
  58. procedure ascii_status_line;
  59. begin
  60.   write('ASCII ');
  61.   rtty_ascii_line;
  62. end;
  63.  
  64. procedure packet_status_line;
  65. begin
  66.   case band of
  67.     HF : write(' HF ');
  68.     VHF : write('VHF ');
  69.   end;
  70.   write('PACKET');
  71.   gotoxy(30,status_line);
  72.   write('Call: ',PKCall);
  73. end;
  74.  
  75. procedure sho_status;
  76. begin
  77.   gotoxy(1,status_line);
  78.   status_color; ClrEol;
  79.   case mode of
  80.     CW    : cw_status_line;
  81.     RTTY  : rtty_status_line;
  82.     ASCII : ascii_status_line;
  83.     PACKET: packet_status_line;
  84.   end;
  85.   if mode in [CW,RTTY,ASCII] then
  86.   begin
  87.     Gotoxy(33,status_line);
  88.     case state of
  89.       transmit      : write(' TRANSMIT ');
  90.       receive       : write(' RECEIVE  ');
  91.     end;
  92.     case auto_switch of
  93.       TRUE          : write('AUTO T/R ');
  94.       FALSE         : write('MAN  T/R ');
  95.     end;
  96.   end;
  97.   show_time;
  98.   gotoxy(1,aux_line); aux_color; ClrEol;
  99.   write('Msgs:',msg_file_name:14);
  100.   if (capture = TRUE) then
  101.   begin
  102.     gotoxy(70,aux_line);
  103.     write('CAPTURE ON');
  104.   end;
  105.   gotoxy(xin,yin);
  106. end;
  107.  
  108. procedure check_if_in_help;
  109. begin
  110.   if viewing_help then
  111.   begin
  112.     restore_screen;
  113.     viewing_help := FALSE;
  114.   end;
  115. end;
  116.  
  117. procedure new_rtty_baud;
  118. begin
  119.   check_if_in_help;
  120.   baud := baud + 1;
  121.   if baud = 9 then
  122.     case mode of
  123.       RTTY  : baud := 0;
  124.       ASCII : baud := 5;
  125.     end;
  126.   set_rtty_baud;
  127.   sho_status;
  128. end;
  129.  
  130. procedure new_rtty_shift;
  131. begin
  132.   check_if_in_help;
  133.   shift := shift + 1;
  134.   if shift = 4 then shift := 0;
  135.   set_rtty_shift;
  136.   sho_status;
  137. end;
  138.  
  139. procedure flip_invert;
  140. begin
  141.   mod_rtty_invert;
  142.   sho_status;
  143. end;
  144.  
  145. procedure change_speed;
  146. var err, old_wpm: integer;
  147. begin
  148.   check_if_in_help;
  149.   xmt_wpm := rcv_wpm;
  150.   val(xmt_wpm, int_wpm, err);
  151.   if err <> 0 then
  152.   begin
  153.     int_wpm := old_wpm;
  154.     str(int_wpm, xmt_wpm);
  155.   end;
  156.   kam_xmt_wpm;
  157.   sho_status;
  158. end;
  159.  
  160. procedure set_speed;
  161. begin
  162.   check_if_in_help;
  163.   prompt_color;
  164.   {$I-}
  165.   repeat
  166.     gotoxy(5,status_line);
  167.     write('    <==');
  168.     gotoxy(6,status_line);
  169.     read(int_wpm);
  170.   until (IOresult = 0) AND (int_wpm > 4) and (int_wpm < 81);
  171.   str(int_wpm,xmt_wpm);
  172.   kam_xmt_wpm;
  173.   sho_status;
  174. end;
  175.  
  176. procedure clear_transmit_screen;
  177. begin
  178.   check_if_in_help;
  179.   window(1,out_start_line,80,out_end_line);
  180.   transmit_color; clrscr;
  181.   full_window;
  182.   xkbd := 1; ykbd := out_start_line;
  183.   attr_pos := ((80*(yout - 1) + xout) SHL 1) - 1;
  184.   halt_xmt;
  185. end;
  186.  
  187. procedure clear_receive_screen;
  188. begin
  189.   check_if_in_help;
  190.   window(1,inp_start_line,80,inp_end_line);
  191.   receive_color;  clrscr;
  192.   xin  := 1; yin  := inp_start_line;
  193.   full_window;
  194. end;
  195.  
  196. procedure clear_screen;
  197. begin
  198.   check_if_in_help;
  199.   clear_receive_screen;
  200.   clear_transmit_screen;
  201.   sho_status;
  202.   gotoxy(1,25); aux_color; ClrEol;
  203.   case mode of
  204.     CW           : write(
  205. ' ^P pause   AS %    AR +     <<< F1 for Help >>>    BT =   SK #   KN (  ^T T/R ');
  206.     RTTY, ASCII  :write(
  207. ' ^P pause                    <<< F1 for Help >>>                        ^T T/R ');
  208.     PACKET       : write(
  209. ' ALT <D>is<K>onnect  <L>calllist  <H>f <V>hf  <I>id  <Z>cmd  <X>exit  <F1> help');
  210.     AMTOR        :write(
  211. '                             <<< F1 for Help >>>                               ');
  212.   end;
  213.   gotoxy(xout,yout);
  214. end;
  215.  
  216. procedure msg_load;
  217. var i : integer;
  218.     msgfile: text;
  219. begin
  220.   check_if_in_help;
  221.   assign(msgfile,msg_file_name);
  222.   {$I-}
  223.   reset(msgfile);
  224.   {$I+}
  225.   if (IOresult = 0) then
  226.   begin
  227.     for i := 0 to 9 do
  228.       readln(msgfile,msg[i]);
  229.     close(msgfile);
  230.   end
  231.   else
  232.   begin
  233.     msg_file_name := '';
  234.     for i := 0 to 9 do
  235.       msg[i] := '';
  236.   end;
  237. end;
  238.  
  239. procedure save_buffer;
  240. label save_fault;
  241. var i : integer;
  242.     rcv_file_name : file_type;
  243.     rcvfile: text;
  244. begin
  245.   rcv_file_name := '';
  246.   if state = transmit then halt_xmt;
  247.   check_if_in_help;
  248.   prompt_color;
  249.   Set_PickWindow_To(10,5,25,22,SingleLine,'Files');
  250.   SayGet(20,aux_line,'Receive (or ?) ',rcv_file_name,_S,24,1);
  251.   WatchKeys := ['?'];
  252.   ReadGets;
  253.   if LastKey = '?' then rcv_file_name := PickFile('*.*');
  254.   if (rcv_file_name <> '') then
  255.   begin
  256.     assign(rcvfile,rcv_file_name);
  257.     {$I-}
  258.     rewrite(rcvfile);
  259.     if (IOresult = 0)
  260.     then
  261.       for i := 0 to max_rcv_buffers do
  262.         begin
  263.           if rcv_buffer[i]^[0] <> #0 then
  264.             write(rcvfile,rcv_buffer[i]^);
  265.           if (IOresult <> 0) then goto save_fault;
  266.         end
  267.     else
  268.       begin
  269.         gotoxy(20,aux_line); ClrEol;
  270.         write('ERROR');
  271.         delay(2000);
  272.       end;
  273. save_fault:
  274.     close(rcvfile);
  275.   end;
  276.   sho_status;
  277. end;
  278.  
  279. procedure view_modify_msgs;
  280. var i : integer;
  281.     nbr, index : integer;
  282.     input_str : string[79];
  283.     nbr_chr : char;
  284. begin
  285.   if state = transmit then halt_xmt;
  286.   check_if_in_help;
  287.   save_screen;
  288.   transmit_color;
  289.   clrscr;
  290.   writeln('Contents of message file: ',msg_file_name);
  291.   writeln;
  292.   for i := 0 to 9 do
  293.   begin
  294.     writeln('Buffer # ',i:1);
  295.     writeln;
  296.   end;
  297.   sayget(1,4,'',msg[0],_S,80,1);
  298.   sayget(1,6,'',msg[1],_S,80,1);
  299.   sayget(1,8,'',msg[2],_S,80,1);
  300.   sayget(1,10,'',msg[3],_S,80,1);
  301.   sayget(1,12,'',msg[4],_S,80,1);
  302.   sayget(1,14,'',msg[5],_S,80,1);
  303.   sayget(1,16,'',msg[6],_S,80,1);
  304.   sayget(1,18,'',msg[7],_S,80,1);
  305.   sayget(1,20,'',msg[8],_S,80,1);
  306.   sayget(1,22,'',msg[9],_S,80,1);
  307.   readgets;
  308.   restore_screen;
  309. end;
  310.  
  311. procedure load_messages;
  312. begin
  313.   if state = transmit then halt_xmt;
  314.   check_if_in_help;
  315.   prompt_color;
  316.   Set_PickWindow_To(10,5,25,22,SingleLine,'Files');
  317.   SayGet(20,aux_line,'Message File (or ?) ',msg_file_name,_S,24,1);
  318.   WatchKeys := ['?'];
  319.   ReadGets;
  320.   if LastKey = '?' then msg_file_name := PickFile('*.*');
  321.   if (msg_file_name <> '') then msg_load;
  322.   sho_status;
  323. end;
  324.  
  325. procedure save_messages;
  326. label save_fault;
  327. var i : integer;
  328.     msgfile: text;
  329. begin
  330.   if state = transmit then halt_xmt;
  331.   check_if_in_help;
  332.   prompt_color;
  333.   Set_PickWindow_To(10,5,25,22,SingleLine,'Files');
  334.   SayGet(20,aux_line,'Message File (or ?) ',msg_file_name,_S,24,1);
  335.   WatchKeys := ['?'];
  336.   ReadGets;
  337.   if LastKey = '?' then msg_file_name := PickFile('*.*');
  338.   if (msg_file_name <> '') then
  339.   begin
  340.     assign(msgfile,msg_file_name);
  341.     {$I-}
  342.     rewrite(msgfile);
  343.     if (IOresult = 0)
  344.     then
  345.       begin
  346.         for i := 0 to 9 do
  347.           begin
  348.             writeln(msgfile,msg[i]);
  349.             if (IOresult <> 0) then goto save_fault;
  350.           end;
  351. save_fault:
  352.         close(msgfile);
  353.       end
  354.     else
  355.       begin
  356.         gotoxy(20,aux_line); ClrEol;
  357.         write('ERROR');
  358.         delay(2000);
  359.       end;
  360.   end;
  361.   sho_status;
  362. end;
  363.  
  364. procedure exit_request;
  365. begin
  366.   save_screen;
  367.   prompt_color;
  368.   window(6,6,29,8);
  369.   clrscr;
  370.   gotoxy(1,2);
  371.   write('Exit to DOS <Y/N> ..');
  372.   repeat key := readkey until key in ['y','n','Y','N'];
  373.   if key in ['y','Y'] then
  374.     quit_flag := true;
  375.   restore_screen;
  376. end;
  377.